C/C++ Users Group Library 1996 July/C-C++ Users Group Library July 1996.iso/vol_200/230_01/prelude.bun

Text File | 1987-05-25 | 49KB | 2,201 lines

: To unbundle, sh this file
echo unbundling Makefile 1>&2
cat >Makefile <<'End'
.SUFFIXES : .st .p
PREPATH = /userfs3/abc/budd/newst/prelude
BINDIR = ../bin

PARSED = class.p object.p \
string.p larray.p nil.p array.p\
boolean.p true.p false.p block.p symbol.p \
magnitude.p number.p integer.p char.p float.p radian.p point.p random.p \
collection.p bag.p set.p kcollection.p dictionary.p scollection.p interval.p \
list.p acollection.p file.p bytearray.p \
semaphore.p process.p smalltalk.p

.st.p:
    $(BINDIR)/parse $(PREPATH)/$*.st >$*.p

install: standard
    -make fastsave

bundle: *.st Makefile savescript
    bundle Makefile savescript init *.st >../prelude.bundle

standard: $(PARSED)
    cat $(PARSED) init >standard

newstd: $(PARSED)
    cat $(PARSED) >newstd

fastsave: standard
    $(BINDIR)/st -m <savescript

clean:
    -rm *.p

# the following are libraries that can be included using the -g switch
#    or using the )g directive

#  form - simple ascii graphics using the curses routines
form: form.p
    mv form.p form

#  pen - line drawing with the plot(3) routines
pen: pen.p
    mv pen.p pen
End
echo unbundling savescript 1>&2
cat >savescript <<'End'
)s stdsave
End
echo unbundling init 1>&2
cat >init <<'End'
smalltalk new
End
echo unbundling acollection.st 1>&2
cat >acollection.st <<'End'
Class ArrayedCollection :SequenceableCollection
| current |
[
       = anArray                       | i |
                (self size ~= anArray size) ifTrue: [^ false].
                i <- 0.
                self do: [:x | (x ~= (anArray at: (i <- i + 1)))
                                ifTrue: [^ false]].
        ^ true
|
        at: key ifAbsent: exceptionBlock
        ((key <= 0) or: [key > self size])
            ifTrue: [^ exceptionBlock value].
                ^ self at: key
|
    coerce: aCollection        | temp |
        temp <- self class new: aCollection size.
        temp replaceFrom: 1 to: aCollection size with: aCollection.
        ^ temp
|
       copyFrom: start to: stop                | size temp |
        size <- stop - start + 1.
        temp <- self class new: size.
        temp replaceFrom: 1 to: size with: self startingAt: start.
        ^ temp
|
        currentKey
                ^ current
|
    deepCopy        | newobj |
        newobj <- self class new: self size.
        (1 to: self size) do:
            [:i | newobj at: i
                put: (self at: i) copy ].
        ^ newobj
|
       do: aBlock
                (1 to: self size)
            do: [:i | current <- i.
                aBlock value: (self at: i)]
|
       first
                current <- 1.
                ^ (current <= self size)
            ifTrue: [ self at: current]
|
    firstKey
        ^ 1
|
    lastKey
        ^ self size
|
    next
                current <- current + 1.
                ^ (current <= self size)
            ifTrue: [ self at: current]
|
    padTo: length
        ^ (self size < length)
            ifTrue: [ self ,
                (self class new: (length - self size) ) ]
            ifFalse: [ self ]
|
    shallowCopy        | newobj |
        newobj <- self class new: self size.
        (1 to: self size) do:
            [:i | newobj at: i
                put: (self at: i) ].
        ^ newobj
]
End
echo unbundling array.st 1>&2
cat >array.st <<'End'
Class Array :ArrayedCollection
[
    new: aValue
        ^ <NewArray aValue>
|
    at: aNumber
        ( (aNumber < 1) or: [aNumber > <Size self> ] )
            ifTrue: [ self error: 'index error'. ^nil ].
        ^ <At self aNumber >
|
    at: aNumber put: aValue
        ( (aNumber < 1) or: [aNumber > <Size self> ] )
            ifTrue: [ self error: 'index error'. ^nil ].
        <AtPut self aNumber aValue >.
        ^ aValue
|
    grow: newObject
        ^ <Grow self newObject>
|
    printString        | value i |
        value <- ')'.
        i <- <Size self>.
        [i > 0] whileTrue:
            [ value <- <At self i>  printString ,
                    ' ', value.
                    i <- i - 1].
        ^ '#( ' , value
|
    size
        ^ <Size self>
]
End
echo unbundling bag.st 1>&2
cat >bag.st <<'End'
Class Bag :Collection
| dict count |
[
        new
                dict <- Dictionary new

|       add: newElement
                dict at: newElement
                     put: (1 + (dict at: newElement ifAbsent: [0]))

|       add: newObj withOccurrences: anInteger
                anInteger timesRepeat: [ self add: newObj ].
                ^ newObj

|       remove: oldElement ifAbsent: exceptionBlock   | i |
                i <- dict at: oldElement
                          ifAbsent: [ ^ exceptionBlock value].
                (1 = i) ifTrue:  [dict removeKey: oldElement]
                        ifFalse: [dict at: oldElement put: i - 1 ]

|       size
                ^ dict inject: 0 into: [:x :y | x + y]

|       occurrencesOf: anElement
                ^ dict at: anElement ifAbsent: [0]

|       first
        (count <- dict first) isNil ifTrue: [^ nil].
        count <- count - 1.
        ^ dict currentKey

|       next
        [count notNil] whileTrue:
           [ (count > 0)
                ifTrue: [count <- count - 1. ^ dict currentKey]
            ifFalse: [(count <- dict next) isNil
                    ifTrue: [^ nil] ]].
        ^ nil

]
End
echo unbundling block.st 1>&2
cat >block.st <<'End'
"
    Class Block.

    Note how whileTrue: and whileFalse: depend upon the parser
    optimizing the loops into control flow, rather than message
    passing.  If this were not the case, whileTrue: would have to
    be implemented using recursion, as follows:

    whileTrue: aBlock
        (self value) ifFalse: [^nil].
        aBlock value.
        ^ self whileTrue: aBlock
"
Class Block
[
    newProcess
        ^ <NewProcess  self>
|
    newProcessWith: argumentArray
        ^ <NewProcess  self argumentArray>
|
    fork
        self newProcess resume.
        ^ nil
|
    forkWith: argumentArray
        (self newProcessWith: argumentArray) resume.
        ^ nil
|
    whileTrue
        ^ [self value ] whileTrue: []
|
    whileTrue: aBlock
        ^ [ self value ] whileTrue: [ aBlock value ]
|
    whileFalse
        ^ [ self value ] whileFalse: []
|
    whileFalse: aBlock
        ^ [ self value ] whileFalse: [ aBlock value ]
|
     value
        <BlockExecute  0>
|
    value: a
        <BlockExecute  1>
|
    value: a value: b
        <BlockExecute  2>
|
    value: a value: b value: c
        <BlockExecute  3>
|
    value: a value: b value: c value: d
        <BlockExecute  4>
|
    value: a value: b value: c value: d value: e
        <BlockExecute  5>
]
End
echo unbundling boolean.st 1>&2
cat >boolean.st <<'End'
Class Boolean
[
        &    aBoolean
        ^ self and: [aBoolean]

|       |    aBoolean
        ^ self or: [aBoolean]

|       and: aBlock
        ^ self and: [aBlock value]

|       or:  aBlock
        ^ self or: [aBlock value]

|    eqv: aBoolean
        ^ self == aBoolean

|    xor: aBoolean
        ^ self ~~ aBoolean
]
End
echo unbundling bytearray.st 1>&2
cat >bytearray.st <<'End'
Class ByteArray :ArrayedCollection
[
    new: size
        ^ <NewByteArray size>
|
    at: index
        ^ <ByteArrayAt self index>
|
    at: index put: value
        <ByteArrayAtPut self index value>
|
    printString    | str |
        str <- '#[ '.
        (1 to: self size)
            do: [:i | str <- str , (self at: i) printString , ' '].
        ^ str , ']'
|
    size
        ^ <ByteArraySize self>
]

End
echo unbundling char.st 1>&2
cat >char.st <<'End'
Class Char :Magnitude
[
    == aChar
        ^ <SameTypeOfObject self aChar>
            ifTrue:  [<CharacterEquality self aChar>]
            ifFalse: [false]
|    < aChar
        ^ <SameTypeOfObject self aChar>
            ifTrue:  [<CharacterLessThan self aChar>]
            ifFalse: [self compareError]
|
    = aChar
        ^ <SameTypeOfObject self aChar>
            ifTrue:  [<CharacterEquality self aChar>]
            ifFalse: [self compareError]
|    > aChar
        ^ <SameTypeOfObject self aChar>
            ifTrue:  [<CharacterGreaterThan self aChar>]
            ifFalse: [self compareError]
|
    asciiValue
        ^ <CharacterToInteger self>
|
    asLowercase
        ^ <IsUpper self>
            ifTrue:  [<ChangeCase self>]
            ifFalse: [self]
|
    asUppercase
        ^ <IsLower self>
            ifTrue:  [<ChangeCase self>]
            ifFalse: [self]
|
    asString
        ^ <CharacterToString self>
|
    compareError
        ^ self error: 'char cannot be compared to non char'
|
    digitValue        | i |
        ((i <- <DigitValue self>) isNil)
            ifTrue: [self error: 'digitValue on nondigit char'].
        ^ i
|
    isAlphaNumeric
        ^ <IsAlnum self>
|
    isDigit
        ^ self between: $0 and: $9
|
    isLetter
        ^ self isLowercase or: [self